home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / genlex.mlp < prev    next >
Encoding:
Text File  |  1994-07-07  |  4.5 KB  |  170 lines  |  [TEXT/MPS ]
  1. (* A generic lexer *)
  2.  
  3. (**) #open "float";;
  4. (**) #open "int";;
  5. (**) #open "ref";;
  6. (**) #open "exc";;
  7. (**) #open "list";;
  8. (**) #open "fchar";;
  9. (**) #open "fstring";;
  10. (**) #open "stream";;
  11.  
  12. (* The string buffering machinery *)
  13.  
  14. let initial_buffer = create_string 32;;
  15.  
  16. let buffer = ref initial_buffer;;
  17. let bufpos = ref 0;;
  18.  
  19. let reset_buffer () =
  20.   buffer := initial_buffer;
  21.   bufpos := 0
  22. ;;
  23.  
  24. let store c =
  25.   if !bufpos >= string_length !buffer then begin
  26.     let newbuffer = create_string (2 * !bufpos) in
  27.     blit_string !buffer 0 newbuffer 0 !bufpos;
  28.     buffer := newbuffer
  29.   end;
  30.   set_nth_char !buffer !bufpos c;
  31.   incr bufpos
  32. ;;
  33.  
  34. let get_string () =
  35.   let s = sub_string !buffer 0 !bufpos in buffer := initial_buffer; s
  36. ;;
  37.  
  38. #ifdef unix
  39. #define ACCENTED `\192`..`\255`
  40. #endif
  41. #ifdef macintosh
  42. #define ACCENTED `\128`..`\160`|`\174`|`\175`|`\190`|`\191`|`\203`|`\207`|\
  43.   `\216`|`\217`|`\222`|`\223`|`\229`..`\239`|`\241`..`\244`
  44. #endif
  45. #ifdef msdos
  46. #define ACCENTED `\128`..`\154`|`\160`..`\165`
  47. #endif
  48.  
  49. (* The lexer *)
  50.  
  51. let make_lexer keywords =
  52.  
  53.   let kwd_table = hashtbl__new 17 in
  54.   do_list (fun s -> hashtbl__add kwd_table s (Kwd s)) keywords;
  55.  
  56.   let ident_or_keyword id =
  57.     try hashtbl__find kwd_table id with Not_found -> Ident id
  58.   and keyword_or_error c =
  59.     let s = make_string 1 c in
  60.       try hashtbl__find kwd_table s
  61.       with Not_found -> raise Parse_error in
  62.  
  63.   let rec next_token = function
  64.     [< '(*'*) ` `|`\010`|`\013`|`\009`|`\026`|`\012`; s >] ->
  65.       next_token s
  66.   | [< '(*'*) `A`..`Z`|`a`..`z`|ACCENTED as c; s>] ->
  67.       reset_buffer(); store c; ident s
  68.   | [< '(*'*) `!`|`%`|`&`|`$`|`#`|`+`|`/`|`:`|`<`|`=`|`>`|`?`|`@`|`\\`|
  69.              `~`|`^`|`|`|`*` as c; s >] ->
  70.       reset_buffer(); store c; ident2 s
  71.   | [< '(*'*) `0`..`9` as c; s>] ->
  72.       reset_buffer(); store c; number s
  73.   | [< '(*'*) `\``; char c; '(*'*) `\`` >] ->
  74.       Char c
  75.   | [< ' `"` (*'*); s >] ->
  76.       reset_buffer(); String(string s)
  77.   | [< '(*'*) `-`; s >] ->
  78.       neg_number s
  79.   | [< '(*'*) `(`; s >] ->
  80.       maybe_comment s
  81.   | [< '(*'*) c >] ->
  82.       keyword_or_error c
  83.       
  84.   and ident = function
  85.     [< '(*'*) `A`..`Z`|`a`..`z`|ACCENTED|`0`..`9`|`_`|`'` (*'*) as c; s>] ->
  86.       store c; ident s
  87.   | [< >] ->
  88.       ident_or_keyword(get_string())
  89.  
  90.   and ident2 = function
  91.     [< '(*'*) `!`|`%`|`&`|`$`|`#`|`+`|`-`|`/`|`:`|`<`|`=`|`>`|`?`|`@`|`\\`|
  92.              `~`|`^`|`|`|`*` as c; s >] ->
  93.       store c; ident2 s
  94.   | [< >] ->
  95.       ident_or_keyword(get_string())
  96.  
  97.   and neg_number = function
  98.     [< '(*'*) `0`..`9` as c; s >] ->
  99.       reset_buffer(); store `-`; store c; number s
  100.   | [< s >] ->
  101.       reset_buffer(); store `-`; ident2 s
  102.     
  103.   and number = function
  104.     [< '(*'*) `0`..`9` as c; s >] ->
  105.       store c; number s
  106.   | [< '(*'*) `.`; s >] ->
  107.       store `.`; decimal_part s
  108.   | [< '(*'*) `e`|`E`; s >] ->
  109.       store `E`; exponent_part s
  110.   | [< >] ->
  111.       Int(int_of_string(get_string()))
  112.  
  113.   and decimal_part = function
  114.     [< '(*'*) `0`..`9` as c; s >] ->
  115.       store c; decimal_part s
  116.   | [< '(*'*) `e`|`E`; s >] ->
  117.       store `E`; exponent_part s
  118.   | [< >] ->
  119.       Float(float_of_string(get_string()))
  120.  
  121.   and exponent_part = function
  122.     [< '(*'*) `+`|`-` as c; s >] ->
  123.       store c; end_exponent_part s
  124.   | [< s >] ->
  125.       end_exponent_part s
  126.  
  127.   and end_exponent_part = function
  128.     [< '(*'*) `0`..`9` as c; s >] ->
  129.       store c; end_exponent_part s
  130.   | [< >] ->
  131.       Float(float_of_string(get_string()))
  132.  
  133.   and string = function
  134.     [< ' `"` (*'*) >] -> get_string()
  135.   | [< '(*'*) `\\`; escape c; s >] -> store c; string s
  136.   | [< '(*'*) c; s >] -> store c; string s
  137.  
  138.   and char = function
  139.     [< '(*'*) `\\`; escape c >] -> c
  140.   | [< '(*'*) c >] -> c
  141.  
  142.   and escape = function
  143.     [< '(*'*) `n` >] -> `\n`
  144.   | [< '(*'*) `r` >] -> `\r`
  145.   | [< '(*'*) `t` >] -> `\t`
  146.   | [< '(*'*) `0`..`9` as c1; '(*'*) `0`..`9` as c2; '(*'*) `0`..`9` as c3 >] ->
  147.       char_of_int((int_of_char c1 - 48) * 100 +
  148.                   (int_of_char c2 - 48) * 10 + (int_of_char c3))
  149.   | [< '(*'*) c >] -> c
  150.  
  151.   and maybe_comment = function
  152.     [< '(*'*) `*`; s >] -> comment s; next_token s
  153.   | [< >] -> keyword_or_error `(`
  154.  
  155.   and comment = function
  156.     [< '(*'*) `(`; s >] -> maybe_nested_comment s
  157.   | [< '(*'*) `*`; s >] -> maybe_end_comment s
  158.   | [< '(*'*) c; s >] -> comment s
  159.  
  160.   and maybe_nested_comment = function
  161.     [< '(*'*) `*`; s >] -> comment s; comment s
  162.   | [< '(*'*) c; s >] -> comment s
  163.  
  164.   and maybe_end_comment = function
  165.     [< '(*'*) `)` >] -> ()
  166.   | [< '(*'*) c; s >] -> comment s
  167.  
  168.   in fun input -> stream_from (fun () -> next_token input)
  169. ;;
  170.